#!/usr/bin/perl

 
# Import needed Modules
use DBI;
use Data::Dumper;
use Date::Manip;
use strict;

my $errors = {
    0 => 0,
    'ZERO' => 0,
    'ERRERR' => 1000,
    'NONE' => 0,
    'DB NOT FOUND' => 1,
    'TEST FAILED'  => 2,    
    'DATA ALREADY PRESENT IN CALENDAR' => 3,
    'MISSED PARAM' => 4,
    'UNKNOWN COMMAND' => 5,
    'UNKNOWN SUB-COMMAND' => 6,
    'DATE ERROR IN PARAM' => 7,
    'INTERNAL' => 8,
    'DATE NOT FOUND IN CALENDAR' => 9,
    'UNKNOWN ERROR CODE IN TEST' => 10,
    'TEST FAILED' => 11,
    'UPDATE FORMAT ERROR' => 12,
    "UNKNOW PROJECT" => 13,
    "NOT ACTIVE PROJECT" => 14,
    "UNIT SUM ERROR" => 15,
    'FEATURE NOT IMPLEMENTED YET' => 16,
    'DATA MISSED' => 17,
};


 
my $dbfile = $ENV{'HOME'}."/worklog.db";
my $dbh;

my $debug= defined($ENV{'DEBUG'}) ? $ENV{'DEBUG'} : 0;

sub show_call_stack {
  my ( $path, $line, $subr );
  my $max_depth = 30;
  my $i = 1;
  my $ret="";
  
  $ret.="--- Begin stack trace ---\n";
  while ( (my @call_details = (caller($i++))) && ($i<$max_depth) ) {
      $ret.="$call_details[1] line $call_details[2] in function $call_details[3]\n";
  }
  $ret.="--- End stack trace ---\n";
  
  return $ret;
}

$SIG{__DIE__} = sub {
	print "\n\n\n====================== PROGRAM ERROR (die) ========================\n\n\n";	
	print "$_[0]\n";
	if($debug) {
	    print "\n\n\n====================== STACK TRACE (die)   ========================\n\n\n";
	    print &show_call_stack();
#	    print "\nPress ENTER...";
#	    $_=<>;
	}
};




sub abort {
    my $line=shift;
    my $codeerr = shift;
    die "unknown coderror at $line: '$codeerr'" unless($errors->{$codeerr});

    print "\n\n\n====================== PROGRAM ERROR (die) ========================\n\n\n";	
    print "LINE: $line - CODERROR: $codeerr\n";
    print "@_\n";
    if($debug) {
	print "\n\n\n====================== STACK TRACE (die)   ========================\n\n\n";
	print &show_call_stack();
#	    print "\nPress ENTER...";
#	    $_=<>;
    }
#    print "--- $errors->{$codeerr};";
    exit $errors->{$codeerr};
}


sub create_tables {
    $dbh->do("drop table if exists CAL");
    $dbh->do("drop table if exists PRJ");
    $dbh->do("drop table if exists LOG");
    $dbh->do("drop table if exists CONFIG");
    $dbh->do("create table CAL (dayid INTEGER PRIMARY KEY AUTOINCREMENT, wno INTEGER,wd INTEGER,y INTEGER,m INTEGER,d INTEGER,committed INTEGER default 0,freeday INTEGER,note TEXT default NULL )");
    $dbh->do("create table PRJ (prjid TEXT PRIMARY KEY,desc TEXT,enabled INTEGER default 1)");
    $dbh->do("create table LOG (dayid INTEGER, prjid TEXT, units REAL, FOREIGN KEY(dayid) REFERENCES CAL(dayid), FOREIGN KEY(prjid) REFERENCES PRJ(prjid) )");
    $dbh->do("create table CONFIG (var TEXT PRIMARY KEY, value TEXT)");

    # now initialize configuration:
    $dbh->do("insert into CONFIG values ('unit_per_day','8.0')");

}

sub sintax {

print "

project	add	<prj-name>	[<description>]		
	del	<prj-name>			
	enable	<prj-name>			
	disable	<prj-name>			
	print	[enabled | disabled | all]			
					
print	week	[<no-week-of-the_year> | {-|+}<n>]
	day	[<yyyy-mm-dd> | {-|+}<n>]
        month	[<yyyy-mm>    | {-|+}<n>]
					
update	<day-date>	 projectname1=units1	[projectname2=units2 [	... ]]
note    <day-date>       <description>
delete	<day-date>	 [<prj-name>]
copy	<copy-from-date> <copy-to-date-1>	[<copy-to-date-2> [	... ]]
					
calendar	generate	{<year>|<month>}
	        setfreeday	<date>			
        	setworkingday	<date>			
	        delete	        {<date>} | {<from-date>	<to-date>}

initdb	[<filename>]

commit	 {<date>} | {<from-date> <to-date>}
			
uncommit {<date>} | {<from-date> <to-date>}

Sub-elements are:
     <prj-name>      : string; a valid project name
     <description>   : string; free text description; use \" to quote, if needed
     <no-week-*>     : week


";

}


sub dbconnect {
    $dbh = DBI->connect("dbi:SQLite:dbname=".$dbfile,"","");
}


sub opendb {
    # Connection to DB file created before
    if(! -f $dbfile) {
	abort(__LINE__,'DB NOT FOUND',"$dbfile not found; execute 'initdb' first");
    }
    dbconnect;
}


sub closedb {
    $dbh->disconnect if($dbh);
}

sub next_param {
    if(@ARGV > 0) {
	return shift @ARGV;
    }else{
	abort(__LINE__,"MISSED PARAM","expected a missed param");
    }
}

sub next_param_as_date {
    my $p = next_param;
    my $date = new Date::Manip::Date;
    my $err = $date->parse($p);
    if($err) {
	abort(__LINE__,"DATE ERROR IN PARAM","Date error for param '$p': ".$date->err);
    }
    return $date;
}

sub exec_query {
    my $query = shift;
    my @params = @_;

    print "exec query: $query\nparams: @params\n\n";

    my $query_handle = $dbh->prepare($query);
    $query_handle->execute();
 
# Instead of simply fetching rows I prefer, for each one,
# to assign values to predefinite values.
# Bind columns is a wonderful function!

    my @refs= map { \my $x } @params;
#    print Dumper(@refs);
    my $res = [];
    $query_handle->bind_columns(@refs);
    while($query_handle->fetch()) {
	my $record = {};
#	print Dumper(@refs)."---";
	my $i=0;
	foreach (@params)  { 
	    my $ref=$refs[$i++];
#	    print Dumper($ref);
	    $record->{$_}=$$ref; 
	} 
	push(@$res,$record);
    }

#    print Dumper($res);
 
# Close connection
    $query_handle->finish;

    return $res;

}

sub smart_select {
    my $complex_sql = shift;
    abort(__LINE__,"INTERNAL","smart_select format invalid for $complex_sql") unless ( $complex_sql =~ /\{([\w,]+)\}/o );
    my $fs=$1;
    my @f = split( /,/,$fs);
    $complex_sql =~ s/\{//o;
    $complex_sql =~ s/\}//o;

    return exec_query($complex_sql,@f);
}

sub smart_delete {
    my $table=shift;
    my $key=shift;
    my $value=shift;
    
    my $res = exec_query ("select $key from $table where $key = '$value'",$key);
    if(@$res == 0 ) {
	abort(__LINE__,"DELETE FAILED","'$value' not found on table '$table'");
    }elsif(@$res == 1) {
	$dbh->do("delete from $table where $key = '$value'");
    }else{
	abort(__LINE__,"INTERNAL");
    }
}

sub print_table {
    # print a result from smart_select
    my $t = shift;
    my @params = @_;

    print Dumper($t);
    
}

sub get_configuration {
    my $s = smart_select ("select {var,value} from CONFIG");
    if(@$s == 0) {
	abort(__LINE__,"INTERNAL","CONFIG table si empty");
    }
    my $res = {};
    map { $res->{$_->{'var'}} = $_->{'value'}; } @$s;
    return $res; 
}



sub get_project {
    my $project = shift;
    
    my $res = exec_query ("select prjid,desc,enabled from PRJ where prjid='$project'",
			  "prjid","desc","enabled");
    if(@$res == 0) {
	return undef;
    }

    if(@$res == 1) {
	return $res->[0];
    }

    abort(__LINE__,"INTERNAL","more results in get_project()");
}

sub get_dayid {
    my $date=shift;
    my $res = smart_select("select {dayid} from CAL where d = ".$date->printf("%d")." and m = ".$date->printf("%m")." and y = ".$date->printf("%Y"));
    print Dumper($res);
    abort(__LINE__,"DATE NOT FOUND IN CALENDAR",$date->printf." (maybe you want to 'generate' it?)") if(@$res == 0);

    return $res->[0]->{'dayid'};
}


sub get_log_by_date {
    my $date = shift;
    my $dayid = get_dayid($date);
    my $res = smart_select ("select {prjid,units} from LOG where dayid = '$dayid'");
    return $res;
}


sub do_test {
    my $line=shift;
    my $expected_coderr = shift;
    print STDERR "TEST[$line] @_ ..." ;
    my $ret = system("perl",$0,@_);
    
    if ($? == -1) {
	abort(__LINE__,"SYSTEM CALL FAILED","failed to execute: $!)");
    }elsif ($? & 127) {
	abort(__LINE__,"SYSTEM CALL FAILED",sprintf("child died with signal %d, %s coredump\n",($? & 127), ($? & 128) ? 'with' : 'without'));
	
    }
    $ret =  $? >> 8;
    abort(__LINE__,"UNKNOWN ERROR CODE IN TEST","expected '$expected_coderr' at line $line") unless(defined( $errors->{$expected_coderr}));

    abort(__LINE__,"TEST FAILED","line number: $line with code $expected_coderr ($errors->{$expected_coderr}) but found $ret") if($ret != $errors->{$expected_coderr});
    print STDERR "($expected_coderr) [OK]\n";
}

sub check_test {
    my $line = shift;
    my $q = shift;
    my $code = shift; 
    print STDERR "CHECK[$line]:$q\n";
    opendb;
    my $res = smart_select($q);
    my $evalres = &$code($res);
    if($evalres != 1) {
	abort($line,"TEST FAILED");
    }
    closedb;
}

# Two simple insert Queries
# I use ->do as I don't need to do anything with returned obj

my $cmd = next_param;
my $subcmd ;
my $othercommand=0;
my $conf = {};

if($cmd eq 'initdb' ) {
    dbconnect;
    create_tables;
    exit 0;
}elsif($cmd eq 'help') {
    sintax;
}else{
    opendb;
    $conf = get_configuration;
#    print Dumper($conf);
    $othercommand=1;
}


if($cmd eq 'project') {
    $subcmd=next_param;
    if($subcmd eq 'add') {
	my $prjname=next_param; 
	my $description=next_param;
	$dbh->do("INSERT INTO PRJ (prjid,desc) VALUES('$prjname','$description')");
    }elsif($subcmd eq 'print' ) {
	my $mode = undef;
	$mode = next_param if(@ARGV);
	my $q;
	my @p;
	if( !defined($mode) || $mode eq 'enabled') {
	    $q="SELECT {prjid,desc} from PRJ where enabled=1 ";
	}elsif($mode eq 'all') {
	    $q="SELECT {prjid,desc,enabled} from PRJ";
	}elsif($mode eq 'disabled') {
	    $q="SELECT {prjid,desc} from PRJ where enabled=0";
	}else{
	    abort(__LINE__,'INTERNAL');
	}
	my $res = smart_select ($q);
	print_table($res);
    }elsif($subcmd eq 'del' ) {
	my $prjname=next_param; 
	smart_delete("PRJ","prjid",$prjname);
    }elsif($subcmd eq 'enable' ) {
	my $prjname=next_param; 
	$dbh->do("UPDATE PRJ SET enabled = 1 where prjid = '$prjname'");
    }elsif($subcmd eq 'disable' ) {
	my $prjname=next_param; 
	$dbh->do("UPDATE PRJ SET enabled = 0 where prjid = '$prjname'");
    }else{
	 abort(__LINE__,"UNKNOWN SUB-COMMAND",$subcmd);
    }
}elsif($cmd eq 'print') {
    $subcmd=next_param;
    my ($today_y,$today_m,$today_d) = (0,0,0); # Date::Manip::Today;
    if($subcmd eq 'week') {
	my $week1=next_param; 
	my $week2=next_param;
	my ($week,$year) = Week_of_Year($today_y,$today_m,$today_d);

	# casi speciali devono essere gestiti:
	if($week1 =~ /^[+-]/o) {
	    $week1 = $week+$week1;
	}
	if($week2 =~ /^[+-]/o) {
	    $week2 = $week+$week2;
	}

	

    }elsif($subcmd eq 'day' ) {

    }elsif($subcmd eq 'month' ) {

    }else{
	abort(__LINE__,'UNKNOWN SUB-COMMAND',$subcmd);
    }
}elsif($cmd eq 'update') {
    my $date = next_param_as_date;
    my $updates = {};
    my $projects = {};

    my $dayid = get_dayid($date);

    abort(__LINE__,"DATA MISSED") if(@ARGV == 0);
    while(@ARGV) {
	my $par = shift @ARGV;
	unless ($par =~ /^(\w+)\=(\d+(\.\d*)?)$/o ) {
	    abort(__LINE__,"UPDATE FORMAT ERROR","format error: $par");
	}
	my ($prj,$u) = ($1,$2);
	my $p = get_project($prj);
	abort(__LINE__,"UNKNOW PROJECT","project name '$prj'") unless(defined($p));
	abort(__LINE__,"NOT ACTIVE PROJECT","project $prj not active") unless($p->{'enabled'} eq '1');
	$updates->{$prj} = $u;
	$projects->{$prj} = $p;
    }
    my $sum = 0;
    map { $sum+=$updates->{$_} } keys(%$updates);
    abort(__LINE__,"UNIT SUM ERROR","sum of units out of value : $sum instead of $conf->{'unit_per_day'}") if ($sum > $conf->{'unit_per_day'});
    
    # LOG (dayid INTEGER, prjid TEXT, units REAL, FO
    foreach my $prjid (keys(%$updates)) {
	my $s = smart_select("select {prjid,units} from LOG where dayid=$dayid and prjid='$prjid'");
	my $q;
	if(@$s == 0) {
	    # insert:
	    $q = "insert into LOG (dayid,prjid,units) VALUES ($dayid,'$prjid',$updates->{$prjid})";
	}elsif(@$s == 1) {
	    # update:
	    $q = "update LOG set units=$updates->{$prjid} where dayid=$dayid and prjid='$prjid'";
	}else{
	    abort(__LINE__,"INTERNAL","more projects found: ".Dumper($s));
	}
	exec_query($q);
    }

}elsif($cmd eq 'delete') {

}elsif($cmd eq 'calendar') {

    $subcmd=next_param;
    my ($what,$year,$month);

    my $today = new Date::Manip::Date;
    $today->parse("today");
    print $today->printf("%Y-%m-%d")."\n";

    my $dmb = new Date::Manip::Base;
    my $wkno = $today->week_of_year;

    my $start_date = new Date::Manip::Date
    my $end_date = new Date::Manip::Date;
    my $one_day = new Date::Manip::Delta;
    $one_day->parse("1 day");

    if($subcmd eq 'generate') {
	my $param=next_param; 
	if($param =~ /^(\d\d\d\d)\-(\d\d)$/o) {
	    abort(__LINE__,"FEATURE NOT IMPLEMENTED YET");
	}elsif($param =~ /^(\d\d\d\d)$/o) {
	    $what='y';
	    $year=$1; 

	    my $err;
	    $err = $start_date->parse("$year-01-01");
	    $err = $end_date->parse("$year-12-31");

	    print $start_date->printf("%Y-%m-%d")."\n";
	    print $end_date->printf("%Y-%m-%d")."\n";
	    my $res = smart_select ("SELECT {dayid} from CAL where y = $year");
	    abort(__LINE__,"DATA ALREADY PRESENT IN CALENDAR",$year) if(@$res != 0);
	    my $cur_date = $start_date;
	    $dbh->do("BEGIN TRANSACTION" );
	    while(  $cur_date->cmp($end_date) < 1 ) {
		# fill up db with the date...
		print $cur_date->printf("%Y-%m-%d")."\n";
		my $wn=$cur_date->week_of_year;
		my $wd=$cur_date->printf("%w");
		my $freeday=$cur_date->is_business_day ? 0 : 1;
		my ($Y,$M,$D,$H,$MN,$S) = $cur_date->value;
		$dbh->do("INSERT INTO CAL (wno,wd,y,m,d,freeday) VALUES ($wn,$wd,$Y,$M,$D,$freeday)");
		print "($wn,$wd,$Y,$M,$D,$freeday)\n";
		$cur_date = $cur_date->calc($one_day);
	    }
	    $dbh->do("END TRANSACTION" );
	}else{
	    abort(__LINE__,'INVALID YEAR',$param);
	}

	

    }elsif($subcmd eq '' ) {
#	print_table($res);
    }else{
	 abort(__LINE__,"UNKNOWN SUB-COMMAND",$subcmd);
    }
}elsif($cmd eq 'commit' || $cmd eq 'uncommit' ) {

}elsif($cmd eq 'test') {
    &test();
}else{    
    abort(__LINE__,'UNKNOWN COMMAND',$cmd) if($othercommand);
}

closedb;


sub test {

    # check some param existence (no real check possibile) 
    do_test(__LINE__,0,"help");
    do_test(__LINE__,'MISSED PARAM');
    
    # check some param error:
    do_test(__LINE__,'UNKNOWN COMMAND',"xxxx");
    do_test(__LINE__,'UNKNOWN SUB-COMMAND',"project","xxx");

    # create DB:

    do_test(__LINE__,0,"initdb");

    # project tests:
    do_test(__LINE__,0,"project","add","prj1","Project 1");
    do_test(__LINE__,0,"project","add","prj2","Project 2");
    do_test(__LINE__,0,"project","add","prj3","Project 3");
    do_test(__LINE__,0,"project","add","prj4","Prokect 4");
    check_test(__LINE__,
	       "select {prjid,desc,enabled} from PRJ order by prjid", 
	       sub { my $res=shift;
#		     print Dumper($res); 
		     return (scalar(@$res) == 4) && 
			 ($res->[3]->{'prjid'} eq 'prj4') &&
#			 (!defined($res->[3]->{'desc'})) &&
			 ($res->[0]->{'desc'} eq  'Project 1') &&
			 ($res->[0]->{'enabled'} == 1);
	       });

    do_test(__LINE__,0,"project","del","prj2");
    do_test(__LINE__,0,'project','disable','prj1');
    check_test(__LINE__,
	       "select {prjid,desc,enabled} from PRJ order by prjid",
	       sub { my $res=shift;
#			 print Dumper($res); 
		     return scalar(@$res) == 3 && 
			 ($res->[0]->{'prjid'} eq 'prj1') &&
			 ($res->[0]->{'enabled'} == 0) ;
	       });
    do_test(__LINE__,0,'project','enable','prj1');
    check_test(__LINE__,
	       "select {prjid,desc,enabled} from PRJ order by prjid",
	       sub { my $res=shift;
#		     print Dumper($res); 
		     return scalar(@$res) == 3 && 
			 ($res->[0]->{'prjid'} eq 'prj1') &&
			 ($res->[0]->{'enabled'} == 1);
	       });

    
    do_test(__LINE__,0,'calendar','generate','2012');
    check_test(__LINE__,
	       "select {dayid,wno,wd,y,m,d,committed,freeday,note} from CAL order by dayid",
	       sub { my $res=shift;
#		     print Dumper($res); 
		     return scalar(@$res) == 366 && 

			 # check 2012-01-01:
			 ($res->[0]->{'y'} eq '2012') &&
			 ($res->[0]->{'m'} eq '1') &&
			 ($res->[0]->{'d'} eq '1') &&
			 ($res->[0]->{'wd'} eq '7') &&
			 ($res->[0]->{'dayid'} eq '1') &&
			 ($res->[0]->{'committed'} == 0) &&

			 # check 2012-12-31:
			 ($res->[365]->{'y'} eq '2012') &&
			 ($res->[365]->{'m'} eq '12') &&
			 ($res->[365]->{'d'} eq '31') &&
			 ($res->[365]->{'wd'} eq '1') &&
			 ($res->[365]->{'dayid'} eq '366') &&
			 ($res->[365]->{'committed'} == 0);

	       });
    do_test(__LINE__,'DATA ALREADY PRESENT IN CALENDAR',
	    'calendar','generate','2012');

    check_test(__LINE__,
	       "select {prjid} from PRJ",
	       sub { my $res=shift;
		     print Dumper($res); 
	       });

    do_test(__LINE__,0,'update','prj1=2.5','prj3=3','prj4=2.5');


    
    print "\n\n\n ===================== \n\n\n FULL TEST OK  !!! \n\n\n\n";

}



